home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-1 / Inter.Net 55-1.iso / CBuilder / Setup / BCB / data.z / atlvcl.cpp < prev    next >
Encoding:
C/C++ Source or Header  |  1998-02-09  |  10.4 KB  |  389 lines
  1. /////////////////////////////////////////////////////////////////////////////
  2. // ATLVCL.CPP - Provides the connective tissue between
  3. //              the ATL framework and VCL components.
  4. //
  5. // $Revision:   1.17.4.4  $
  6. // $Date:   05 Feb 1998 20:22:36  $
  7. //
  8. // Copyright (c) 1998 Borland International
  9. /////////////////////////////////////////////////////////////////////////////
  10.  
  11. #include <vcl.h>
  12. #pragma hdrstop
  13.  
  14. #if !defined(__ATLVCL_H_)
  15. #include <atl\atlvcl.h>
  16. #endif
  17. #include <comconst.hpp>
  18. #include <axctrls.hpp>
  19.  
  20. // Variable to store away System's InitProc
  21. //    
  22. void* SaveInitProc;
  23.  
  24. // Unlock routine - Handles case of Local Server by posting WM_QUIT message
  25. //
  26. LONG TComModule::Unlock()
  27. {
  28.   LONG result = CComModule::Unlock();
  29.  
  30.   // If there are no more locks on us, if we were launch via Automation and we're an EXE, Quit
  31.   //
  32.   if ((result == 0) && m_bExe)
  33.   {
  34.     TSysCharSet DelimSet;
  35.     DelimSet << '/' << '-';
  36.     if (FindCmdLineSwitch("AUTOMATION", DelimSet, true))
  37.       ::PostThreadMessage(m_ThreadID, WM_QUIT, 0, 0);
  38.   }
  39.   return result;
  40. }
  41.  
  42. // Converts a GUID to an AnsiString
  43. //
  44. static AnsiString GuidToString(const GUID& guid)
  45. {
  46.   LPOLESTR P;
  47.   if (::StringFromCLSID(guid, &P) != S_OK)
  48.     return "";
  49.   AnsiString S = P;
  50.   CoTaskMemFree(P);
  51.   return S;
  52. }
  53.  
  54. // Helper used by IPersistStreamInit implementation to save component
  55. //
  56. void __fastcall SaveVCLComponentToStream(TComponent *vclInstance, LPSTREAM pStream)
  57. {
  58.   TVclPtr<TOleStream> OleStrm(new TOleStream(_di_IStream(pStream)));
  59.   TVclPtr<TWriter> Writer(new TWriter(OleStrm, 4096));
  60.   Writer->IgnoreChildren = true;
  61.   Writer->WriteDescendent(vclInstance, NULL);
  62. }
  63.  
  64.  
  65. // Helper used by IPersistStreamInit implementation to load component
  66. //
  67. void __fastcall LoadVCLComponentFromStream(TComponent *vclInstance, LPSTREAM pStream)
  68. {
  69.   TVclPtr<TOleStream> OleStrm(new TOleStream(_di_IStream(pStream)));
  70.   OleStrm->ReadComponent(vclInstance);
  71. }
  72.  
  73.  
  74. // Helper used by framework to create a reflector object
  75. //
  76. TWinControl* CreateReflectorWindow(HWND parent, Controls::TControl* Control)
  77. {
  78.   return new TReflectorWindow(int(parent), Control);
  79. }
  80.  
  81.  
  82. static HRESULT UnregisterTypeLibInterfaces(ITypeLib *pTypeLib)
  83. {
  84.   HRESULT hr = S_OK;
  85.   int cTypeInfo = pTypeLib->GetTypeInfoCount();
  86.   for (int i = 0; i < cTypeInfo; i++)
  87.   {
  88.     TYPEKIND tk;
  89.     hr = pTypeLib->GetTypeInfoType(i, &tk);
  90.     if (SUCCEEDED(hr) && (tk == TKIND_DISPATCH || tk == TKIND_INTERFACE))
  91.     {
  92.       CComPtr<ITypeInfo> pTypeInfo;
  93.       hr = pTypeLib->GetTypeInfo(i, &pTypeInfo);
  94.       if (SUCCEEDED(hr))
  95.       {
  96.         TYPEATTR* pTypeAttr;
  97.         hr = pTypeInfo->GetTypeAttr(&pTypeAttr);
  98.         if (SUCCEEDED(hr))
  99.         {
  100.           // Build key to delete
  101.           //
  102.           AnsiString key("Interface\\");
  103.           key += GuidToString(pTypeAttr->guid);
  104.           pTypeInfo->ReleaseTypeAttr(pTypeAttr);
  105.           
  106.           TComServerRegistrar::NukeRegKey(key);
  107.         }
  108.         pTypeInfo.Release();
  109.       }
  110.     }
  111.   }
  112.   return hr;
  113. }
  114.  
  115. // Creates a Registry Key
  116. //
  117. void TComServerRegistrar::CreateRegKey(AnsiString keyStr, AnsiString ValueName, AnsiString Value)
  118. {
  119.   CRegKey key;
  120.   LONG status = key.Create(HKEY_CLASSES_ROOT, keyStr.c_str());
  121.   
  122.   if (status == ERROR_SUCCESS)
  123.     status = key.SetValue(Value.c_str(), ValueName.c_str());
  124.    
  125.   if (status != ERROR_SUCCESS)
  126.     throw EWin32Error(status);
  127. }
  128.  
  129. // Deletes a Registry Key
  130. // NOTE: A quirk of Windows is that under Win95, ::RegDeleteKey also deletes all descendants
  131. //       whereas under NT the subkey to be deleted must not have subkeys. 
  132. // 
  133. void TComServerRegistrar::DeleteRegKey(AnsiString keyStr)
  134. {
  135.   LONG status = ::RegDeleteKey(HKEY_CLASSES_ROOT, keyStr.c_str());
  136.   if (status != ERROR_SUCCESS)
  137.     throw EWin32Error(status);  
  138. }
  139.  
  140. // Delete a Registry Key and all subkeys
  141. //
  142. void TComServerRegistrar::NukeRegKey(AnsiString keyStr)
  143. {
  144.   // Open the Key
  145.   //
  146.   CRegKey key;
  147.   key.Attach(HKEY_CLASSES_ROOT);
  148.   LONG status = key.RecurseDeleteKey(keyStr.c_str());
  149.   if (status != ERROR_SUCCESS)
  150.     throw EWin32Error(status);
  151. }
  152.  
  153. // Initialize variables required for registering server
  154. //
  155. void TComServerRegistrar::Init(void)
  156. {
  157.   // Retrieve name of this module
  158.   //
  159.   TCHAR szBuffer[MAX_PATH];
  160.   ::GetModuleFileName(_Module.m_hInst, szBuffer, sizeof(szBuffer));
  161.   m_ModuleName = szBuffer;
  162.   
  163.   // Create string with registry key
  164.   //
  165.   m_ClassKey = _T("CLSID\\");
  166.   m_ClassKey += GuidToString(m_ClassID);
  167.   
  168.   // Create string for server type
  169.   //
  170.   if (_Module.m_bExe)
  171.     m_ServerType = _T("\\LocalServer32");
  172.   else
  173.     m_ServerType = _T("\\InprocServer32");
  174. }
  175.  
  176. // Registers (or Unregisters) keys of this server
  177. //   
  178. HRESULT TComServerRegistrar::UpdateRegistry(bool Register)
  179. {
  180.   if (Register)
  181.   {
  182.     static TCHAR szAutomation[] = _T(" /Automation");
  183.  
  184.     // Create registry entries
  185.     //
  186.     CreateRegKey(m_ClassKey, "", m_Description);
  187.  
  188.     // Make sure we have /Automation on EXE Automation Servers
  189.     //
  190.     if (_Module.m_bExe && _Module.m_bAutomationServer)
  191.     {
  192.       CreateRegKey(m_ClassKey + m_ServerType, "", m_ModuleName + szAutomation);
  193.     }
  194.     else
  195.     {
  196.       CreateRegKey(m_ClassKey + m_ServerType, "", m_ModuleName);
  197.     }
  198.  
  199.     // NOTE: VCL does not support Free Threading model
  200.     //     Hence, we're limited to Single or Apartment Threading model.
  201.     //   
  202. #if defined(_ATL_APARTMENT_THREADED)
  203.     CreateRegKey(m_ClassKey + m_ServerType, _T("ThreadingModel"), _T("Apartment"));
  204. #else
  205.     CreateRegKey(m_ClassKey + m_ServerType, _T("ThreadingModel"), _T("Single"));
  206. #endif
  207.  
  208.     // Register CLSID/ProgID
  209.     //  
  210.     if (!m_ProgID.IsEmpty())
  211.     {
  212.       CreateRegKey(m_ProgID, "", m_Description);
  213.       CreateRegKey(m_ProgID + _T("\\CLSID"), "", GuidToString(m_ClassID));
  214.       CreateRegKey(m_ClassKey +  _T("\\ProgID"), "", m_ProgID);
  215.     }
  216.   }
  217.   else
  218.   {
  219.     // Remove registry entries
  220.     //
  221.     if (!m_ProgID.IsEmpty())
  222.     {
  223.       NukeRegKey(m_ClassKey);
  224.       NukeRegKey(m_ProgID);
  225.     }
  226.   }
  227.   return S_OK;
  228. }
  229.  
  230. // Registers (or Unregisters) Server with TypeLibrary
  231. //
  232. HRESULT TTypedComServerRegistrar::UpdateRegistry(bool Register)
  233. {
  234.   // Load the Module's type library (assumes TypeLibrary is part of module)
  235.   //
  236.   TComInterface<ITypeLib> pTypeLib;
  237.   HRESULT hres = ::LoadTypeLib(m_ModuleName.c_bstr(), &pTypeLib);
  238.   if (hres != S_OK) 
  239.     return hres;
  240.  
  241.   // Retrieve ITypeInfo
  242.   //
  243.   TComInterface<ITypeInfo> pTypeInfo;
  244.   hres = pTypeLib->GetTypeInfoOfGuid(m_ClassID, &pTypeInfo);
  245.   if (!SUCCEEDED(hres))
  246.     return hres;
  247.  
  248.   // Get description
  249.   //
  250.   WideString Description;
  251.   hres = pTypeInfo->GetDocumentation(MEMBERID_NIL, NULL,
  252.                         (BSTR*)(&Description), NULL, NULL);
  253.   if (SUCCEEDED(hres))
  254.     m_Description = AnsiString(Description);
  255.  
  256.   // Obtain TLIBATTR for this type library
  257.   //
  258.   TLIBATTR *pTypeAttr;
  259.   hres = pTypeLib->GetLibAttr(&pTypeAttr);
  260.   if (!SUCCEEDED(hres))
  261.     return hres;
  262.  
  263.   // Get type library version number and GUID from TLIBATTR
  264.   //
  265.   WORD wMajor = pTypeAttr->wMajorVerNum;
  266.   WORD wMinor = pTypeAttr->wMinorVerNum;
  267.   /*
  268.   GUID libID  = pTypeAttr->guid;
  269.   */
  270.   pTypeLib->ReleaseTLibAttr(pTypeAttr);
  271.  
  272.   if (Register)
  273.   {
  274.     // Make registry entries
  275.     // Call base first when registering
  276.     //
  277.     TComServerRegistrar::UpdateRegistry(Register);
  278.  
  279.     // Create TypeLibrary keys
  280.     //
  281.     TCHAR szBuffer[128];
  282.     wsprintf(szBuffer, _T("%d.%d"), wMajor, wMinor);
  283.  
  284.     AnsiString VersionNum(szBuffer);
  285.     CreateRegKey(m_ClassKey + _T("\\Version"), "", VersionNum);
  286.  
  287.     AnsiString LibIDStr = GuidToString(pTypeAttr->guid);
  288.     CreateRegKey(m_ClassKey + _T("\\Typelib"), "", LibIDStr);
  289.  
  290.     hres = ::RegisterTypeLib(pTypeLib, m_ModuleName, 0);
  291.   }
  292.   else
  293.   {
  294.     // Call base to unregister
  295.     // NOTE: Base class nukes everything under \\CLSID\\<clsid>
  296.     //
  297.     hres = TComServerRegistrar::UpdateRegistry(Register);
  298.   }
  299.   return hres;
  300. }
  301.  
  302.  
  303. // Register (or unregisters) Remote data module
  304. //
  305. HRESULT TRemoteDataModuleRegistrar::UpdateRegistry(bool bRegister)
  306. {
  307.    HRESULT hr = TTypedComServerRegistrar::UpdateRegistry(bRegister);
  308.  
  309.    // Code specific to Remote Data Modules
  310.    //
  311.    if (&Forms::UpdateDataModuleRegistry != NULL)
  312.      Forms::UpdateDataModuleRegistry(bRegister, GuidToString(m_ClassID), m_ProgID);
  313.    return hr;
  314. }
  315.  
  316.  
  317. // Registers (or Unregisters) ActiveX Control
  318. //
  319. HRESULT TAxControlRegistrar::UpdateRegistry(bool Register)
  320. {
  321.   HRESULT hres;
  322.   if (Register)
  323.   {
  324.     // Call base first when registering
  325.     //
  326.     hres = TTypedComServerRegistrar::UpdateRegistry(Register);
  327.  
  328.     // Make registry entries
  329.     //
  330.     CreateRegKey(m_ClassKey + _T("\\MiscStatus"), "", '0');
  331.     CreateRegKey(m_ClassKey + _T("\\MiscStatus\\1"), "", (int)m_MiscFlags);
  332.     CreateRegKey(m_ClassKey + _T("\\ToolboxBitmap32"), "",
  333.                  m_ModuleName + "," + IntToStr(m_BitmapID));
  334.     CreateRegKey(m_ClassKey + _T("\\Control"), "", "");
  335.     CreateRegKey(m_ClassKey + _T("\\Verb"), "", "");
  336.  
  337.     // Register Verbs
  338.     //
  339.     const OLEVERB *pVerb = m_Verbs;
  340.     while (pVerb->lpszVerbName && *pVerb->lpszVerbName)
  341.     {
  342.       AnsiString szKey(m_ClassKey);
  343.       szKey += _T("\\Verb\\");
  344.       szKey += IntToStr(pVerb->lVerb);
  345.  
  346.       AnsiString szVerb= pVerb->lpszVerbName;
  347.       szVerb += ",";
  348.       szVerb += IntToStr(pVerb->fuFlags);
  349.       szVerb += ",";
  350.       szVerb += IntToStr(pVerb->grfAttribs);
  351.  
  352.       CreateRegKey(szKey, "", szVerb);
  353.  
  354.       pVerb++;
  355.     }
  356.   }
  357.   else
  358.   {
  359.     // Call base class to unregister
  360.     // NOTE: Base class removes everything underneath \\CLSID\\<clsid> && \\<progid>\\
  361.     //
  362.     hres = TTypedComServerRegistrar::UpdateRegistry(Register);
  363.   }
  364.   return hres;
  365. }
  366.  
  367.  
  368. // AutomationTerminateProc
  369. //
  370. // Verifies if a Server was launched with the /Automation switch and warns 
  371. // user of attempt to unload Server currently being automated.
  372. //
  373. bool __fastcall AutomationTerminateProc()  
  374. {
  375.   TSysCharSet DelimSet;
  376.   DelimSet << '/' << '-';
  377.   if (FindCmdLineSwitch("AUTOMATION", DelimSet, true))
  378.   {
  379.     return ::MessageBox(0, (Comconst_SNoCloseActiveServer1 + Comconst_SNoCloseActiveServer2).c_str(),
  380.                         Comconst_SAutomationWarning.c_str(), 
  381.                         MB_YESNO|MB_TASKMODAL|MB_ICONWARNING|MB_DEFBUTTON2) == IDYES;
  382.   }
  383.   else 
  384.     // If not launched with /Automation, it's fine to unload
  385.     //
  386.     return True;
  387. }
  388.  
  389.